home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / pas_all.zip / TI673.ASC < prev    next >
Text File  |  1992-02-28  |  5KB  |  265 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.   PRODUCT  :  Turbo Pascal                           NUMBER  :  673
  9.   VERSION  :  6.0
  10.        OS  :  MS/PC DOS
  11.      DATE  :  February 28, 1992                        PAGE  :  1/4
  12.  
  13.     TITLE  :  Runtime Menubar and Statusline Change
  14.  
  15.  
  16.  
  17.  
  18.   {
  19.  
  20.   This program changes menus at runtime as well as changing
  21.   the statusline.  This program demonstrates how to change the
  22.   statusline and the active commands linked to the statusline
  23.   options.
  24.  
  25.   }
  26.  
  27.   {$X+}
  28.   program ExampleProgram;
  29.  
  30.   uses
  31.     Drivers, Objects, Views, App, Menus, Puzzle, Calendar;
  32.   const
  33.     PuzzleCmd   = 100;
  34.     CalendarCmd = 101;
  35.     SwitchCmd   = 102;
  36.  
  37.   var
  38.     StatusLine1: PStatusLine;
  39.  
  40.   type
  41.     TTestMain = object(TApplication)
  42.       OtherMenu: PMenuBar;
  43.       constructor Init;
  44.       procedure Calendar;
  45.       procedure HandleEvent(var Event: TEvent); virtual;
  46.       procedure InitMenuBar; virtual;
  47.       procedure InitStatusLine; virtual;
  48.       procedure Puzzle;
  49.       procedure SwitchMenu;
  50.     end;
  51.  
  52.   { TTestMain }
  53.   constructor TTestMain.Init;
  54.   begin
  55.     TApplication.Init;
  56.   end;
  57.  
  58.   procedure TTestMain.Calendar;
  59.   var
  60.     CalendarWindow: PCalendarWindow;
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.   PRODUCT  :  Turbo Pascal                           NUMBER  :  673
  75.   VERSION  :  6.0
  76.        OS  :  MS/PC DOS
  77.      DATE  :  February 28, 1992                        PAGE  :  2/4
  78.  
  79.     TITLE  :  Runtime Menubar and Statusline Change
  80.  
  81.  
  82.  
  83.  
  84.   begin
  85.     CalendarWindow := new(PCalendarWindow, Init);
  86.     DeskTop^.Insert(CalendarWindow);
  87.   end;
  88.  
  89.   procedure TTestMain.HandleEvent(var Event: TEvent);
  90.   begin
  91.     TApplication.HandleEvent(Event);
  92.     if Event.What = evCommand Then
  93.     begin
  94.       case Event.Command of
  95.         PuzzleCmd   : Puzzle;
  96.         CalendarCmd : Calendar;
  97.         SwitchCmd   : SwitchMenu;
  98.       else
  99.         Exit;
  100.       end;
  101.       ClearEvent(Event);
  102.     end;
  103.   end;
  104.  
  105.   Procedure TTestMain.InitMenuBar;
  106.   var
  107.     R: TRect;
  108.   begin
  109.     GetExtent(R);
  110.     R.B.Y := R.A.Y+1;
  111.     MenuBar := New(PMenuBar, Init(R, NewMenu(
  112.        NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
  113.        NewSubMenu('~E~xample',hcNoContext,NewMenu(
  114.        NewItem('~P~uzzle','', 0, PuzzleCmd, hcNoContext,
  115.        NewItem('~C~alendar','', 0, CalendarCmd, hcNoContext,
  116.        NewLine(
  117.        NewItem('~Q~uit', '',0, cmQuit,
  118.   hcNoContext,Nil))))),Nil)))));
  119.     OtherMenu := New(PMenuBar, Init(R, NewMenu(
  120.        NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
  121.        NewSubMenu('~O~ther Menu',hcNoContext,NewMenu(
  122.        NewItem('~B~y', '', 0, cmQuit, hcNoContext,
  123.        NewLine(
  124.        NewItem('~Q~uit', '',0, cmQuit,
  125.   hcNoContext,Nil)))),Nil)))));
  126.   end;
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.   PRODUCT  :  Turbo Pascal                           NUMBER  :  673
  141.   VERSION  :  6.0
  142.        OS  :  MS/PC DOS
  143.      DATE  :  February 28, 1992                        PAGE  :  3/4
  144.  
  145.     TITLE  :  Runtime Menubar and Statusline Change
  146.  
  147.  
  148.  
  149.  
  150.   procedure TTestmain.InitStatusLine;
  151.   var R: TRect;
  152.   begin
  153.     GetExtent(R);
  154.     R.A.Y := R.B.Y - 1;
  155.     StatusLine := New(PStatusLine, Init(R,
  156.       NewStatusDef(0, $FFFF,
  157.         NewStatusKey('', kbF10, cmMenu,
  158.         NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  159.         nil)),
  160.       nil)
  161.     ));
  162.     StatusLine1 := New(PStatusLine, Init(R,
  163.       NewStatusDef(0, $FFFF,
  164.         NewStatusKey('', kbF10, cmMenu,
  165.         NewStatusKey('~P~uzzle', kbAltP, PuzzleCmd,
  166.         nil)),
  167.       nil)
  168.     ));
  169.   end;
  170.  
  171.  
  172.   procedure TTestMain.Puzzle;
  173.   var
  174.    PuzzleWindow: PPuzzleWindow;
  175.   begin
  176.     PuzzleWindow := new(PPuzzleWindow, Init);
  177.     DeskTop^.Insert(PuzzleWindow);
  178.   end;
  179.  
  180.   procedure TTestMain.SwitchMenu;
  181.   var
  182.     Temp: PMenuBar;
  183.     Temp1: PStatusLine;
  184.   begin
  185.     Delete(MenuBar);
  186.     Temp := PMenuBar(MenuBar);
  187.     MenuBar := OtherMenu;
  188.     OtherMenu := Temp;
  189.     Insert(MenuBar);
  190.     Delete(StatusLine);
  191.     Temp1 := PStatusLine(StatusLine);
  192.     StatusLine := StatusLine1;
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.   PRODUCT  :  Turbo Pascal                           NUMBER  :  673
  207.   VERSION  :  6.0
  208.        OS  :  MS/PC DOS
  209.      DATE  :  February 28, 1992                        PAGE  :  4/4
  210.  
  211.     TITLE  :  Runtime Menubar and Statusline Change
  212.  
  213.  
  214.  
  215.  
  216.     StatusLine1 := Temp1;
  217.     Insert(StatusLine);
  218.     MenuBar^.DrawView;
  219.     StatusLine^.DrawView;
  220.   end;
  221.  
  222.   var
  223.     Main: TTestMain;
  224.  
  225.   begin
  226.     Main.Init;
  227.     Main.Run;
  228.     Main.Done;
  229.   end.
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.